home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 5 / chrpro3.zip / MCSFUNDS.CMD < prev    next >
OS/2 REXX Batch file  |  1991-01-21  |  12KB  |  427 lines
  1. *Program MCSFUNDS - Edits Special Account records in CDIRFILE
  2. Store T to LEVEL3
  3. Select secondary
  4. USE CDIRFILE index CDIRFILE
  5. Do while LEVEL3
  6. Erase
  7. @ 1,1 say chname
  8. @ 1,62 say curdate
  9. @ 2,1  say 'DATA DISK = '+D
  10. @ 3,20 say '   CONTRIB Special Funds editing               8-/MCSFUNDS/'
  11. @ 5,9  say '1)  Add contributions to Special Funds'
  12. @ 6,9  say '2)  Edit Special Fund contributions'
  13. @ 7,9  say '3)  Delete Special Fund contributions'
  14. @ 8,9 say  '4)  Display the Special Fund Letters, names'
  15. @ 9,9 say  '5)  Add a Special Fund category'
  16. @ 10,9 say '6)  Edit a Special Fund category'
  17. @ 11,9 say '7)  Delete a Special Fund category'
  18. @ 12,9 say '8)  Compute Special Funds totals'
  19. @ 13,9 say '9)  Display Special Fund amounts'
  20. ?
  21. Accept '            Enter selection ' to MSEL
  22. ?
  23. Do while @(MSEL,'123456789Qq')=0
  24.   Accept 'Invalid entry. Please enter again ' to MSEL
  25. enddo
  26. ?
  27. If !(MSEL)='Q'
  28.   Store F to LEVEL3
  29. else
  30.   Do CASE
  31.     CASE MSEL='1'
  32. Select secondary
  33. ? '     Week number dates of this period -'
  34. ?
  35. Store 1 to NN
  36. Do while NN<wknummax
  37.   ?? str(NN,2),'  '
  38.   Store NN+1 to NN
  39. enddo
  40. ?
  41. Store 1 to NN
  42. Do while NN<wknummax
  43.   ?? $(curdates,NN*6-5,5)
  44.   Store NN+1 to NN
  45. enddo
  46. ?
  47. Accept 'Enter a week number ' to XX
  48. Do while (val(XX)<1.or.val(XX)>=wknummax) .and. !(XX)<>'Q'
  49.   Accept 'Invalid week number. Please enter another ' to XX
  50. enddo
  51. Store val(XX) to wknumb
  52. Store '0' to EN
  53. Do while EN<>'Q'
  54.   ?
  55.   Accept 'Enter an envelope number ("Q"=quit) ' to EN
  56.   Do while (val(EN)<0.or.val(EN)>offermax) .and. !(EN)<>'Q'
  57.     Accept 'Invalid envelope number. Please enter another ' to EN
  58.   enddo
  59.   ?
  60.   If !(EN)<>'Q'
  61.     Store val(EN) to envl
  62.     ? '  Current Special Fund letters: ',CSA
  63.     Accept '  Enter a Special Fund letter ' to XX
  64.     Store '$'+XX to SFFUND
  65.     Find &SFFUND
  66.     Do while @(XX,CSA)=0 .or. #=0
  67.       Accept 'Invalid Special Fund letter. Please enter another ' to XX
  68.       Store '$'+XX to SFFUND
  69.       Find &SFFUND
  70.     enddo
  71.     ?
  72. Store 0.00 to NN
  73. ?
  74. ?
  75. ?
  76. @ 22,1 say ;
  77. 'Enter amount to be recorded for this envelope number and week, fund' get NN
  78. READ
  79. ? 'Now recording $',NN,' into Special Fund =',$(CDIRINDEX,2,11)
  80. ? 'for week',$(curdates,wknumb*6-5,6),'and envelope',str(envl,4),'.'
  81. Accept '                                                            OK? ' to xx
  82. If  !(XX)='Y'
  83.  Append blank
  84.   Replace CDIRINDEX with SFFUND+'.'+$(curdates,wknumb*6-5,5)+str(envl,4)
  85.    Replace spact with str(NN,11,2)
  86.     endif
  87.      endif
  88.      enddo
  89. CASE MSEL='2' .or. MSEL='3'
  90. Select secondary
  91. ? '     Week number dates of this period -'
  92. ?
  93. Store 1 to NN
  94. Do while NN<wknummax
  95.   ?? str(NN,2),'  '
  96.   Store NN+1 to NN
  97. enddo
  98. ?
  99. Store 1 to NN
  100. Do while NN<wknummax
  101.   ?? $(curdates,NN*6-5,5)
  102.   Store NN+1 to NN
  103. enddo
  104. ?
  105. Accept 'Enter a week number ' to XX
  106. Do while (val(XX)<1.or.val(XX)>=wknummax) .and. !(XX)<>'Q'
  107.   Accept 'Invalid week number. Please enter another ' to XX
  108. enddo
  109. Store val(XX) to wknumb
  110. Store '0' to EN
  111. ? 'This process requires you to enter a known envelope number and Special'
  112. ? 'Fund letter.  Along with the above week number, the program will search for'
  113. If MSEL='2'
  114.   ? 'a match, and if found, allows changing the values in that record.'
  115. else
  116.   ? 'a match, and if found, the record is deleted.'
  117. endif
  118. Do while EN<>'Q'
  119.   ?
  120.   Accept 'Enter an envelope number ("Q"=quit) ' to EN
  121.   Do while (val(EN)<1.or.val(EN)>offermax) .and. !(EN)<>'Q'
  122.     Accept 'Invalid envelope number. Please enter another ' to EN
  123.   enddo
  124.   ?
  125.   If !(EN)<>'Q'
  126.     Store val(EN) to envl
  127.     ? '  Current Special Fund letters:',CSA
  128.     Accept '  Enter the Special Fund letter ' to XX
  129.     Store '$'+XX+'.'+$(curdates,wknumb*6-5,5)+str(envl,4) to SFFUND
  130.     Find &SFFUND
  131.     If #=0
  132.       Accept 'Special Fund not found for these entries. Press <RETURN> ' to XX
  133.       Store 'Q' to XX
  134.     else
  135.       Store $(cdirindex,2,1) to SPFUND
  136.       Store str(wknumb,2) to wkx
  137.     endif
  138.     ?
  139.   endif
  140.   If !(XX)<>'Q' .and. !(EN)<>'Q'
  141.     If MSEL='3'
  142.       Accept 'About to delete this record. OK? ' to xx
  143.       If !(XX)='Y'
  144.         Replace CDIRINDEX with $(CDIRINDEX,1,2)+'|'+$(CDIRINDEX,4,9)
  145.       endif
  146.     else
  147.   Store $(spact,1,11) to XX
  148.   Store &XX to NN
  149.   ?
  150.   ?
  151.   ?
  152.   ?
  153.   @ 20,4  say 'Spec.Fund amount' get NN
  154.   @ 21,4  say 'Envelope number ' get envl
  155.   @ 20,44 say 'Week number     ' get wkx
  156.   @ 20,72 say  $(curdates,wknumb*6-5,5)
  157.   @ 21,44 say 'Special Fund    ' get SPFUND
  158.   READ
  159.   ? 'Now recording $',NN,' into Special Fund =',$(CDIRINDEX,2,11)
  160.   ?
  161.   Accept ' The old record will be written over.                     OK? ' to xx
  162.   If  !(XX)='Y'
  163.     Store val(wkx) to wknumb
  164.     Replace CDIRINDEX with '$'+SPFUND+'.'+$(curdates,wknumb*6-5,5)+str(envl,4)
  165.     Replace spact with str(NN,11,2)
  166.   endif
  167.   endif
  168.   endif
  169. enddo
  170.     CASE MSEL='4'
  171.       Select secondary
  172.       GOTO 51
  173.       ?
  174.       Set raw on
  175.       Do while .not. EOF
  176.         Do while @($(cdirindex,3,1),'.*')<>0.and. .not. EOF
  177.           SKIP
  178.         enddo
  179.         If .not. EOF
  180.           ?? ' ',$(cdirindex,2,2),$(spact,1,17)
  181.         endif
  182.         SKIP
  183.       enddo
  184.       ?
  185.       Set raw off
  186.       Accept 'End of Special Funds. Press <RETURN> ' to xx
  187.     CASE MSEL='5'
  188. ?
  189. ?
  190. Store ' ' to SF
  191. Do while !(SF)<>'Q'
  192. ? '     Current Special Fund letters: ',CSA
  193. ?
  194. Accept 'Enter a Special Fund letter to be added ' to SF
  195. Store '$'+$(SF,1,1)+'*' to SFX
  196. Find &SFX
  197. Do while #=0.and.!(SF)<>'Q'
  198.   If #=0
  199.     Accept 'Invalid Special Fund Designator. Please enter another ' to SF
  200.     Store '$'+$(SF,1,1)+'*' to SFX
  201.     Find &SFX
  202.   endif
  203. enddo
  204. If !(SF)<>'Q'
  205.   ?
  206.   Accept 'Enter a name for this Special Fund ' to SFNAME
  207.   Store sfname+'                      ' to sfname
  208.   Store $(sfname,1,22) to sfname
  209.   ?
  210.   ? 'Now adding Special Fund  [',$(SF,1,1),']  - ',SFNAME
  211.   Accept '                                                 OK? ' to XX
  212.   If !(XX)='Y'
  213.     Replace CDIRINDEX with '$'+$(SF,1,1)+'  '+date()
  214.     Replace SPACT with SFNAME
  215.     Store CSA+$(SF,1,1) to CSA
  216.     GOTO 49
  217.     Store trim(spact) to tspact
  218.     If len(tspact)=39
  219.       GOTO 50
  220.       Store trim(spact) to tspact
  221.     endif
  222.     Replace spact with tspact+SF
  223.   else
  224.     ? 'Special Fund is NOT added.'
  225.     ?
  226.   endif
  227. endif
  228. enddo
  229.     CASE MSEL='6'
  230. ?
  231. ?
  232. Store ' ' to SF
  233. Do while !(SF)<>'Q'
  234.   ? '    Current Special Fund letters: ',CSA
  235.   ?
  236.   Accept 'Select a Special Fund letter to edit ("Q"=quit) ' to SF
  237.   Store '$'+$(SF,1,1)+' ' to SFX
  238.   Find &SFX
  239.   Do while #=0 .and. !(SF)<>'Q'
  240.     Accept 'Invalid Special Fund Designator. Please enter another ' to SF
  241.     Store '$'+$(SF,1,1)+' ' to SFX
  242.     Find &SFX
  243.   enddo
  244.   If !(SF)<>'Q'
  245.     Store $(spact,1,22) to SFNAME
  246.     Store 0.00 to SFTOTAL
  247.     Store val($(spact,23,9))+sftotal to SFTOTAL
  248.     ?
  249.     ?
  250.     ?
  251.     ?
  252.     @ 21,10 say 'Special Fund Name           ' get SFNAME
  253.     @ 21,62 say 'FUND:',$(cdirindex,2,11)
  254.     @ 22,10 say 'Special Fund Previous Total ' get SFTOTAL
  255.     READ
  256.     ?
  257.     ? 'Now changing to  - ',SFNAME,'      $',SFTOTAL
  258.     Accept '                                                       OK? ' to XX
  259.     If !(XX)='Y'
  260.       Replace spact with SFNAME+str(sftotal,9,2)+$(spact,23,9)
  261.     endif
  262. endif
  263. enddo
  264.     CASE MSEL='7'
  265.       ?
  266.       Store ' ' to SF
  267.       Do while !(SF)<>'Q'
  268.         ? '    Current Special Fund letters: ',CSA
  269.         ?
  270.         Accept 'Select a Special Fund letter to delete ("Q"=quit) ' to SF
  271.         Store '$'+$(SF,1,1)+' ' to SFX
  272.         Find &SFX
  273.         Do while (#=0 .and. !(SF)<>'Q') .or. SF='-'
  274.           Accept 'Invalid Special Fund Designator. Please enter another ' to SF
  275.           Store '$'+$(SF,1,1)+' ' to SFX
  276.           Find &SFX
  277.         enddo
  278.         If !(SF)<>'Q'
  279.           ?
  280.   ? 'About to delete Special Fund = [',$(cdirindex,2,1),'] ',$(spact,1,22)
  281.   ? 'This will cancel the Fund name and all individual contributions under it.'
  282.   Accept '                                                        OK? ' to XX
  283.   If !(XX)='Y'
  284.     Replace cdirindex with $(SFX,1,2)+'* '+date()
  285.     SKIP
  286.     Store $(SFX,1,2)+'.' to SFX
  287.     Do while cdirindex=SFX
  288.       ? 'CANCELED:',$(cdirindex,4,9),spact
  289.       Replace CDIRINDEX with $(SFX,1,2)+'|'
  290.       SKIP
  291.     enddo
  292.     GOTO 49
  293.     Store F to THERE
  294.     If @($(SFX,2,1),spact)<>0
  295.       Store T to THERE
  296.     else
  297.       SKIP
  298.       If @($(SFX,2,1),spact)<>0
  299.         Store T to THERE
  300.       endif
  301.     endif
  302.     If THERE
  303.       Store @($(SFX,2,1),spact) to N
  304.       Replace spact with $(spact,1,N-1)+$(spact,N+1,40-N)
  305.     endif
  306.   endif
  307.   endif
  308.   ? 'This Special Fund is now cancelled.'
  309.   ?
  310.   ?
  311.   enddo
  312.     CASE MSEL='9'
  313.   Store '$-' to SFUNDS
  314.   Find &SFUNDS
  315.   If #<>0
  316.   ? '             CONTRIBUTIONS Special Funds Totals      ',curdate
  317. ?
  318. ? '                                                 Previous  New       Full'
  319. ? ' LAST DATE   FUND     Special Fund Name          Total     Total     Total'
  320. ? '  TOTALED   LETTER                               Amount    Amount    Amount'
  321. ? ' --------   ------    ---------------------     --------  -------   -------'
  322.   Do while .not. EOF
  323.     If $(cdirindex,3,1)=' '
  324.       Store 0.00 to sfnd
  325.       Store sfnd+val($(spact,23,9))+val($(spact,32,9)) to sfnd
  326. ? $(cdirindex,4,9),'  [',$(cdirindex,2,1),']    ',$(spact,1,22),' '
  327. ?? $(spact,23,19),str(sfnd,9,2)
  328.     endif
  329.     SKIP
  330.   enddo
  331.   ?
  332.   Accept 'End of totals. Press <RETURN> ' to XX
  333.   else
  334.     Accept 'No Special Funds found. Press <RETURN> ' to xx
  335.   endif
  336.     CASE MSEL='8'
  337.  Store ' ' to SF
  338.  Do while SF<>'Q'
  339.  Accept 'Enter a Special Fund letter (Press <RETURN> for all) ' to SF
  340.  ?
  341.  If !(SF)<>'Q'
  342.   If SF<>' '
  343.     Store '$'+SF+' ' to SF
  344.     Find &SF
  345.     If #<>0
  346.       ? '  NOW TOTALING  [',$(cdirindex,2,1),']   ',$(spact,1,22)
  347.       Store $(SF,1,2)+'.' to SFF
  348.       Store str(#,4) to SFNUMB
  349.       SKIP
  350.       Store $(CDIRINDEX,1,2) to SFX
  351.       Store 0.00 to SFAMOUNT
  352.       Do while SFF=SFX
  353.         Store SFAMOUNT+val($(spact,1,11)) to SFAMOUNT
  354.         ? '       ',cdirindex,$(spact,1,11)
  355.         SKIP
  356.         Store $(CDIRINDEX,1,3) to SFX
  357.       enddo
  358.       GOTO &SFNUMB
  359.       ? '                        --------'
  360.       ? '        TOTAL      $',str(sfamount,11,2),'   [',$(cdirindex,2,1),']  '
  361.       ?? $(spact,1,22)
  362.       Replace cdirindex with $(CDIRINDEX,1,4)+date()
  363.       Replace spact with $(spact,1,31)+str(SFAMOUNT,9,2)
  364.       ?
  365.     else
  366.       Accept 'Special Fund not found. Press <RETURN> ' to xx
  367.     endif
  368.   else
  369.     Store '$-' to SF
  370.     Find &SF
  371.     If #<>0
  372.      Do while .not. EOF
  373.       ?
  374.   ? 'Contributions Special Fund TOTAL    [',$(cdirindex,2,1),']',$(spact,1,22)
  375.       Store $(cdirindex,1,2)+'.' to SFF
  376.       Store str(#,4) to SFNUMB
  377.       SKIP
  378.       Store $(CDIRINDEX,1,3) to SFX
  379.       Store 0.00 to SFAMOUNT
  380.       Do while SFF=SFX
  381.         Store SFAMOUNT+val($(spact,1,11)) to SFAMOUNT
  382.         ? '       ',cdirindex,$(spact,1,11)
  383.         SKIP
  384.         Store $(CDIRINDEX,1,3) to SFX
  385.       enddo
  386.       Store str(#,4) to SFNUMBX
  387.       GOTO &SFNUMB
  388.       ? '                        --------'
  389.       ? '        TOTAL      $',str(sfamount,11,2),'   [',$(cdirindex,2,1),']'
  390.       ?? $(spact,1,22)
  391.       ?
  392.       ?
  393.       Replace cdirindex with $(CDIRINDEX,1,4)+date()
  394.       Replace spact with $(spact,1,31)+str(SFAMOUNT,9,2)
  395.       GOTO &SFNUMBX
  396.       Do while $(cdirindex,3,1)<>' ' .and. .not. EOF
  397.         SKIP
  398.       enddo
  399.     enddo
  400.    endif
  401.   endif
  402.   endif
  403.   Accept 'Totals are complete. Press <RETURN> ' to xx
  404.   Store 'Q' to SF
  405. endif
  406. enddo
  407. endif
  408.     CASE MSEL<>'Q'
  409.     Accept 'These routines are not written, yet. ' to xx
  410.   endcase
  411. endif
  412. enddo
  413. Select secondary
  414. Use
  415. Select primary
  416. Release LEVEL3,NN,EN,WKNUMB,ENVL,SFFUND,SFNUBM,WKX,SPFUND,SFNAME,TSPACT,SFND,SF
  417. Release SFX,SFTOTAL,THERE,SFUNDS,SFND,SFF,SFAMOUNT,SFNUMBX
  418. RETURN
  419. ete Special Fund = [',$(cdirindex,2,1),'] ',$(spact,1,22)
  420.   ? 'This will cancel the Fund name and all individual contributions under it.'
  421.   Accept '                                                        OK? ' to XX
  422.   If !(XX)='Y'
  423.     Replace cdirindex with $(SFX,1,2)+'* '+date()
  424.     SKIP
  425.     Store $(SFX,1,2)+'.' to SFX
  426.     Do while cdirindex=SFX
  427.       ?